delphi：SQL Server导出数据到 EXCEL

【例子介绍】

【相关图片】

【源码结构】

unit CodeBox;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, ComCtrls, Db, DBTables, DBCGrids, Mask, DBCtrls,
  ExtCtrls,INIFiles,comObj,ADODB,Menus;
Function Convert_Str(Temp_S:String):String;//将日期转换成 YYYY/MM/DD字符串
Function ConvertTimeToNum(H,M:String;ADD_Hour:Integer):Real;
Function ReturnFieldDataType(Field:TField):String;
Procedure ExportToExcel_01(aDataSet:TCustomADODataSet);
Procedure ExportToExcel_02(aDataSet:TCustomADODataSet);
function getclassname(tmpclass:string):tform;  //动态建立表单
function decryptstr(const s:string; skey:string):string;//解密
function encryptstr(const s:string; skey:string):string;//加密
function HexToStr(AStr: string): string;
function StrToHex(AStr: string): string;
function TransChar(AChar: Char): Integer;
function ReadHex(AString: string): integer;
Procedure ShowForm(FormName:String);
function IsWindowExists(form_1:string):boolean ;

implementation


function IsWindowExists(form_1:string):boolean ;
var com_count,i:integer;
begin
    com_count:=strtoint((inttostr(Application.ComponentCount)))-1;
    for i:=0 to com_count do
    begin
        if Application.Components[i].Name=form_1 then
          break;
    end;
    if i > com_count  then
      result:=false
    else
      result:=true;
end;



Procedure ShowForm(FormName:String);
var
    Findform:TForm;
    FindFormClass:TFormClass;
begin
   Findform:=TForm(FormName);
   FindFormClass:=TFormClass(FindClass('T' FormName));
   if FindFormClass<>Nil then
   Begin
      Application.CreateForm(FindformClass,FindForm);
      Findform.showModal;
   End;
end;

function ReadHex(AString: string): integer;
begin
    try
        Result:=StrToInt('$' AString);
    except
        Result:=0;
    end;
end;






function TransChar(AChar: Char): Integer;
begin
  if AChar in ['0'..'9'] then
   Result := Ord(AChar) - Ord('0')
  else
   Result := 10   Ord(AChar) - Ord('A');
end;


function StrToHex(AStr: string): string;
var
I : Integer;
begin
Result := '';
For I := 1 to Length(AStr) do
begin
Result := Result   Format('%2x', [Byte(AStr[I])]);
end;
I := Pos(' ', Result);
While I <> 0 do
begin
Result[I] := '0';
I := Pos(' ', Result);
end;
end;

function HexToStr(AStr: string): string;
var
I : Integer;
Charvalue: Word;
begin
Result := '';
For I := 1 to Trunc(Length(Astr)/2) do
begin
Result := Result   ' ';
Charvalue := TransChar(AStr[2*I-1])*16   TransChar(AStr[2
*I]);
Result[I] := Char(Charvalue);
end;
end;


function encryptstr(const s:string; skey:string):string;//加密
var
    i,j: integer;
    hexS,hexskey,midS,tmpstr:string;
    a,b,c:byte;
begin
    hexS   :=StrtoHex(s);
    hexskey:=StrtoHex(skey);
    midS   :=hexS;
    for i:=1 to (length(hexskey) div 2)   do
    begin
        if i<>1 then midS:= tmpstr;
        tmpstr:='';
        for j:=1 to (length(midS) div 2) do
        begin
            a:=strtoint('$' midS[2*j-1] midS[2*j]);
            b:=strtoint('$' hexskey[2*i-1] hexskey[2*i]);
            c:=a xor b;
            tmpstr := tmpstr StrtoHex(chr(c));
        end;
    end;
    result := tmpstr;
end;

function decryptstr(const s:string; skey:string):string;//解密
var
    i,j: integer;
    hexS,hexskey,midS,tmpstr:string;
    a,b,c:byte;
begin
    hexS :=s;//应该是该字符串
    if length(hexS) mod 2=1 then
    begin
        showmessage('密文错误！');
        exit;
    end;
    hexskey:=StrtoHex(skey);
    tmpstr :=hexS;
    midS   :=hexS;
    for i:=(length(hexskey) div 2) downto 1 do
    begin
        if i<>(length(hexskey) div 2) then midS:= tmpstr;
        tmpstr:='';
        for j:=1 to (length(midS) div 2) do
        begin
            a:=strtoint('$' midS[2*j-1] midS[2*j]);
            b:=strtoint('$' hexskey[2*i-1] hexskey[2*i]);
            c:=a xor b;
            tmpstr := tmpstr StrtoHex(chr(c));
        end;
    end;
    result := HextoStr(tmpstr);
end;






function getclassname(tmpclass:string):tform;
var
 cclass:tclass;
begin
 cclass:=getclass(tmpclass);//取得类名
 if cclass <>nil then   //如果这个类已经注册
   application.createform(tcomponentclass(cclass),result);//创建这个类的实例
end;



Procedure ExportToExcel_01(aDataSet:TCustomADODataSet);
var
   xlApp,xlBook,xlSheet,xlQuery: Variant;
begin
   xlApp := CreateOleObject('Excel.Application');
   xlBook := xlApp.Workbooks.Add;
   xlSheet := xlBook.Worksheets['sheet1'];
   xlApp.Visible := false;
   xlQuery := xlSheet.QueryTables.Add(aDataset.Recordset,xlSheet.Range['A1']); //??琌?
   xlQuery.FieldNames := True;
   xlQuery.RowNumbers := False;
   xlQuery.FillAdjacentFormulas := False;
   xlQuery.PreserveFormatting := True;
   xlQuery.RefreshOnFileOpen := False;
   xlQuery.BackgroundQuery := True;
   //xlQuery.RefreshStyle := xlInsertDeleteCells;
   xlQuery.SavePassword := True;
   xlQuery.SaveData := True;
   xlQuery.AdjustColumnWidth := True;
   xlQuery.RefreshPeriod := 0;
   xlQuery.PreserveColumnInfo := True;
   xlQuery.FieldNames := True;
   xlQuery.Refresh;
   xlApp.Visible := true;
End;

Procedure ExportToExcel_02(aDataSet:TCustomADODataSet);
var
   xlApp,xlBook,xlSheet: Variant;
   i:integer;
begin
   xlApp := CreateOleObject('Excel.Application');
   xlBook := xlApp.Workbooks.Add;
   xlSheet := xlBook.Worksheets['sheet1'];
   xlApp.Visible := True;
   For i:=0 to aDataSet.FieldCount-1 do
      xlsheet.cells[1,i 1]:=ADataset.Fields[i].FieldName;
   XLsheet.Cells[2,1].CopyFromRecordset(Adataset.Recordset,Adataset.RecordCount,Adataset.Fields.Count);
End;

Function ConvertTimeToNum(H:String;M:String;ADD_Hour:Integer):Real;
VAR Hour,Minute,c,c1:Integer;
Begin
   VAl(H,Hour,C);
   VAL(M,Minute,C1);
   RESULT:=(Hour ADD_HOUR)*60 Minute;
End;


Function Convert_Str(Temp_S:String):String;
VAR S_p,S1,S2,s3,Tempstr1:String;
    i,Code,j:Integer;
begin
      S_p:=Trim(Temp_s);
      i:=Pos('/',S_P);
      Tempstr1:=trim(Copy(S_p,i 1,Length(S_P)));
      j:=Pos('/',TempStr1);
      S2:=Copy(TempStr1,1,j-1);
      S3:=Trim(Copy(TempStr1,j 1,Length(TempStr1)-j));
      s1:=copy(s_p,1,4);
      Val(S2,i,Code);
      IF i<10 Then
      Begin
         Str(i,S2);
         S2:='0' Trim(S2);
      End;
      Val(S3,i,Code);
      IF i<10 Then
      Begin
         Str(i,S3);
         S3:='0' Trim(S3);
      End;
      S_p:=S1 '/' S2 '/' S3;
      Result:=S_P;
End;
Procedure   WriteINI(Var SSQL,SUser,Spwd,SDB:String);
Var
   INI:TIniFile;
Begin
   Ini.WriteString('SQL','SERVER',SSQL);
   Ini.WriteString('SQL','User',SUser);
   Ini.WriteString('SQL','Password',SPwd);
   Ini.WriteString('SQL','DATABASE',SDB);
End;
//********************************
//********************
Function ReturnFieldDataType(Field:TField):String;
Begin
   Case Field.DataType OF
         ftUnknown:
            Result:='ftUnknown';
         ftString:
            Result:='ftString';
         ftSmallint:
            Result:='ftSmallint';
         ftInteger:
            Result:='ftInteger';
         ftWord:
            Result:='ftword';
         ftBoolean:
            Result:='ftBoolean';
         ftFloat:
            Result:='ftFloat';
         ftCurrency:
            Result:='ftCurrency';
         ftBCD:
            Result:='ftBCD';
         ftDate:
            Result:='ftDate';
         ftTime:
            Result:='ftTime';
         ftDateTime:
            Result:='ftDateTime';
         ftBytes:
            Result:='ftBytes';
         ftVarBytes:
            Result:='ftVarBytes';
         ftAutoInc:
            Result:='ftAutoINC';
         ftBlob:
            Result:='ftBlob';
         ftMemo:
            Result:='ftMemo';
         ftGraphic:
            Result:='ftGraphic';
         ftFmtMemo:
            Result:='ftFmtMemo';
         ftParadoxOle:
            Result:='ftParadoxOle';
         ftDBaseOle:
            Result:='ftBaseOle';
         ftTypedBinary:
            Result:='fttypeBinary';
         ftCursor:
            Result:='ftCursor';
         ftFixedChar:
            Result:='ftFixedChar';
         ftWideString:
            Result:='ftWideString';
         ftLargeint:
            Result:='ftLargeint';
         ftADT:
            Result:='ftADT';
         ftArray:
            Result:='ftArray';
         ftReference:
            Result:='ftReference';
         ftDataSet:
            Result:='ftDataSet';
         ftOraBlob:
            Result:='ftORABlob';
         ftOraClob:
            Result:='ftOraclob';
         ftVariant:
            Result:='ftVariant';
         ftInterface:
            Result:='ftInterface';
         ftIDispatch:
            Result:='ftDispatch';
         ftGuid:
            Result:='ftGuid';
         ftTimeStamp:
            Result:='ftTimeStamp';
         ftFMTBcd:
            Result:='ftFmtBCD';
   end;
End;


end.